home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1997 February / PC Plus Super CD (Issue 124) (PCP124-2-97) (February 1997).iso / ms / vb5cce / controls / samples / clrbox2 / clrbox2.exe / modTimer.bas < prev    next >
Encoding:
BASIC Source File  |  1996-10-25  |  4.0 KB  |  75 lines
  1. Attribute VB_Name = "modTimer"
  2. Option Explicit
  3. '-------------------------------------------------------------------------
  4. 'modTimer is a support module for clsTimer
  5. '-------------------------------------------------------------------------
  6.  
  7. Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  8. Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
  9.  
  10. Public gcTimerObjects As Collection     'Timer object that are instanciated WithEvents
  11.                                         'Add themselves to this collection when they need
  12.                                         'to start a timer. Set Timer returns a TimerID which
  13.                                         'the timer object converts to a string and uses as a key
  14.                                         'when it adds itself to the collection. The Callback
  15.                                         'function converst the passed TimerID to a string
  16.                                         'and uses it as a key to this collection.
  17.  
  18. Public Sub TimerProc(ByVal lHwnd As Long, ByVal lMsg As Long, ByVal lTimerID As Long, ByVal lTime As Long)
  19.     '-------------------------------------------------------------------------
  20.     'Purpose:   Address of this function is passed in the SetTimer API.  When
  21.     '           a system timer is started it calls this function every set
  22.     '           interval
  23.     'In:        [lTimerID]
  24.     '           Equals the return value of the SetTimer API.  It basically identifies
  25.     '           what system timer called this function so that I can trigger a
  26.     '           raise event in the Timer object that started the calling
  27.     '           system timer.
  28.     'Effects:   Finds a clsTimerLink class object in the gcTimerObjects collection
  29.     '           whose key matches the lTimerID parameter.  Calls the RaiseTick
  30.     '           method on the found object.
  31.     '-------------------------------------------------------------------------
  32.     Dim oTimerObject As clsTimerLink
  33.     On Error Resume Next                'Error handling because TimerProc
  34.                                         'can be called after objects
  35.                                         'are destroyed
  36.     Set oTimerObject = gcTimerObjects.Item(Str$(lTimerID))
  37.     oTimerObject.RaiseTick
  38. End Sub
  39.  
  40. Public Function StartTimer(lInterval As Long) As Long
  41.     '-------------------------------------------------------------------------
  42.     'Purpose:   Starts a system timer
  43.     'In:        [lInterval]
  44.     '           The interval in milliseconds for the desired timer
  45.     'Effects:   Calls the SetTimer API, passing the AddressOF the TimerProc
  46.     '           Function and lInterval
  47.     '-------------------------------------------------------------------------
  48.     StartTimer = SetTimer(0, 0, lInterval, AddressOf TimerProc)
  49. End Function
  50.  
  51. Public Function StopTimer(lTimerID As Long) As Long
  52.     '-------------------------------------------------------------------------
  53.     'Purpose:   Stops a specific system timer
  54.     'In:        [lTimerID]
  55.     '           The ID of the specific system timer to stop
  56.     'Effects:   Calls the KillTimerID API, passing lTimerID
  57.     '-------------------------------------------------------------------------
  58.     StopTimer = KillTimer(0, lTimerID)
  59. End Function
  60.  
  61. Public Sub SetInterval(lInterval As Long, lTimerID As Long)
  62.     '-------------------------------------------------------------------------
  63.     'Purpose:   Changes the interval of an alreading existing system timer
  64.     'In:        [lTimerID]
  65.     '           The ID of the specific system timer to change
  66.     '           [lInterval]
  67.     '           The interval to change the timer to.
  68.     'Effects:   Calls the SetTimer API, passing lTimerID, lInterval, and the
  69.     '           AddressOf TimerProc
  70.     '-------------------------------------------------------------------------
  71.     Dim lResult As Long
  72.     lResult = SetTimer(0, lTimerID, lInterval, AddressOf TimerProc)
  73. End Sub
  74.  
  75.